home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr47 / sb16snd.zip / SBRECORD.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-18  |  4KB  |  171 lines
  1. {           Copyright 1995 by Ethan Brodsky.  All rights reserved.           }
  2. program SBRecord; {$X+}
  3.   uses
  4.     CRT,
  5.     DOS,
  6.     SBIO,
  7.     XMS;
  8.   const
  9.     BaseIO = $220;
  10.     IRQ    = 5;
  11.     DMA16  = 5;
  12.     SaveChunkSize = 8192;
  13.     BlockLength   = 256;
  14.   type
  15.     PBuffer = ^TBuffer;
  16.     TBuffer = array[1..2] of array[1..BlockLength] of integer;
  17.   var
  18.     Time: real;
  19.     Rate: word;
  20.     FileName: string;
  21.  
  22.     NumSamples: LongInt;
  23.     Buffer: PBuffer;
  24.  
  25.     Handle: word;
  26.     CurOffset: LongInt;
  27.     DataSize: LongInt;
  28.  
  29.   function GetParameters(var Time: real; var Rate: word; var FName: string): boolean;
  30.     var
  31.       Code: integer;
  32.       i: byte;
  33.     begin
  34.       GetParameters := false;
  35.       if ParamCount <> 3
  36.         then
  37.           Exit
  38.         else
  39.           begin
  40.             Val(ParamStr(1), Time, Code);
  41.             if Code <> 0 then Exit;
  42.  
  43.             Val(ParamStr(2), Rate, Code);
  44.             if Code <> 0 then Exit;
  45.  
  46.             FName := ParamStr(3);
  47.             for i := 1 to Length(FName) do FName[i] := UpCase(FName[i]);
  48.             GetParameters := true;
  49.           end;
  50.     end;
  51.  
  52.   var
  53.     RecordMoveParams: TMoveParams;
  54.   procedure RecordHandler; far;
  55.     begin
  56.       if CurOffset < DataSize
  57.         then
  58.           begin
  59.             with RecordMoveParams do
  60.               begin
  61.                 if (CurOffset+BlockLength*2) <= DataSize
  62.                   then Length := BlockLength*2
  63.                   else Length := DataSize-CurOffset;
  64.                 SourceHandle  := 0;
  65.                 SourceOffset  := LongInt(@(Buffer^[CurBlock]));
  66.                 DestHandle    := Handle;
  67.                 DestOffset    := CurOffset;
  68.               end;
  69.             XMSMove(@RecordMoveParams);
  70.             Inc(CurOffset, BlockLength*2);
  71.           end;
  72.     end;
  73.  
  74.   var
  75.     SaveMoveParams: TMoveParams;
  76.   procedure WriteData;
  77.     type IntArray = array[1..SaveChunkSize div 2] of integer;
  78.     var
  79.       f: file;
  80.       Chunk: array[1..SaveChunkSize] of byte;
  81.     begin
  82.       Assign(f, FileName);  ReWrite(f, 1);
  83.  
  84.       with SaveMoveParams do
  85.         begin
  86.           SourceHandle := Handle;
  87.           SourceOffset := 0;
  88.           DestHandle   := 0;
  89.           DestOffset   := LongInt(Addr(Chunk));
  90.         end;
  91.  
  92.       while DataSize > 0 do
  93.         begin
  94.           if DataSize > SaveChunkSize
  95.             then SaveMoveParams.Length := SaveChunkSize
  96.             else SaveMoveParams.Length := DataSize;
  97.           XMSMove(@SaveMoveParams);
  98.           BlockWrite(f, Chunk, SaveMoveParams.Length);
  99.           Inc(SaveMoveParams.SourceOffset, SaveMoveParams.Length);
  100.           Dec(DataSize, SaveMoveParams.Length);
  101.         end;
  102.  
  103.       Close(f);
  104.     end;
  105.  
  106.   procedure Init;
  107.     begin
  108.       GetBuffer(pointer(Buffer), BlockLength);
  109.  
  110.       NumSamples := Round(Time*Rate);
  111.  
  112.       XMSInit;
  113.       DataSize := NumSamples * 2;
  114.       if not(XMSAllocate(Handle, (DataSize div 1024)+1))
  115.         then
  116.           begin
  117.             writeln('ERROR:  Not enough free XMS');
  118.             writeln('        Bytes required:  ', 2 * NumSamples);
  119.             writeln('        Bytes free:      ', XMSGetFreeMem * 1024);
  120.             Halt(2);
  121.           end;
  122.  
  123.       CurOffset := 0;
  124.  
  125.       FillChar(Buffer^, SizeOf(Buffer^), $FF);
  126.  
  127.       SetHandler(@RecordHandler);
  128.       SBIO.Init(BaseIO, IRQ, DMA16, Input, Rate);
  129.       StartIO(NumSamples);
  130.     end;
  131.  
  132.   procedure Shutdown;
  133.     begin
  134.       SBIO.Shutdown;
  135.       SetHandler(nil);
  136.       FreeBuffer(pointer(Buffer));
  137.     end;
  138.  
  139.   begin
  140.     writeln('SBRECORD - Copyright 1995 by Ethan Brodsky.  All rights reserved.');
  141.     if GetParameters(Time, Rate, FileName)
  142.       then
  143.         writeln('Recording for ', Time:0:2, ' seconds at ', Rate, ' HZ to ', FileName)
  144.       else
  145.         begin
  146.           writeln('Syntax:  sbrecord <time> <rate> <filename>');
  147.           writeln('Example: sbrecord 2.0 22050 test.raw');
  148.           Halt(1);
  149.         end;
  150.  
  151.     Init;
  152.  
  153.     repeat until Done or KeyPressed;
  154.  
  155.     if KeyPressed
  156.       then
  157.         begin
  158.           writeln('Recording canceled by keypress');
  159.           ReadKey;
  160.           ShutDown
  161.         end
  162.       else
  163.         begin
  164.           Shutdown;
  165.           WriteData;
  166.         end;
  167.  
  168.     XMSFree(Handle);
  169.  
  170.     writeln;
  171.   end.